Unit OpInt; {***************************************************************************} {* *} {* O p u s I n t e r f a c e V e r 1.02 *} {* *} {* Opus V 1.0x Interface for Turbo Pascal Ver 4.0 *} {* *} {* These Structures,Procedures and Functions may help you to make OPUS *} {* utilities for to help other SysOps, Please read the Dokumentation. *} {* *} {* Regards *} {* Per Holm *} {* *} {* FIDO: Per Holm - Asgaard BBS 2:230/22.0 *} {* UUCP: perholm@daimi.DK *} {* *} {***************************************************************************} Interface Uses Dos; CONST { Some Nice helpfull constants } _Months = 'JanFebMarAprMayJunJulAugSepOctNovDec'; TYPE _Lines = String[80]; _StrSys = String[39]; _Str = STRING[64]; {***************************************************************************} {* MESSAGE AND FILE AREAS *} {***************************************************************************} {---------------------------------------------------------------------------} {- Area attributes ( Limit or describe the behavior of an area -} {---------------------------------------------------------------------------} CONST SYSMAIL = $01; {* Is a mail area *} SYSOVR = $02; {* Overwrite files is OK *} NOPUBLIC = $04; {* OPUS: Disallow public messages *} NOPRIVATE = $08; {* OPUS: Disallow private messages *} ANON_OK = $10; {* OPUS: Enable anonymous messages *} ECHOMAIL = $20; {* OPUS: Set = Echo-Mail, Clear = no echo mail *} {---------------------------------------------------------------------------} {- System??.BBS structure ( Don't consider the structure stable -} {---------------------------------------------------------------------------} TYPE _Sys = RECORD {******************************************} ls_caller : Word; {* *} priv : Integer; {* Privilege to use this area *} Msgpath : _StrSys; {* Path to message directory *} Bbspath : _StrSys; {* Path to .BBS files / Barricade files *} Hlppath : _StrSys; {* Path to help directory *} Uplpath : _StrSys; {* Path to Upload Directory. *} filepath : _StrSys; {* Path to download directory *} attrib : Integer; {* Message/File Atributes (look up.) *} ms_caller : Integer; {* *} Quote : LongInt; {* *} End; {******************************************} _MSGAREA = RECORD {******************************************} AREA: Integer; {* Area Number (0-99) *} MSG: Integer; {* Message Number *} END; {******************************************} {***************************************************************************} {* OPUS USER FILE Structure *} {***************************************************************************} {---------------------------------------------------------------------------} {- User Privileges -} {---------------------------------------------------------------------------} CONST Twit = -2; Disgrace = 0; Normal = 2; Privil = 4; Privileged = 4; Extra = 6; AsstSysOp = 8; SysOp = 10; Hidden = 11; {---------------------------------------------------------------------------} {- User Setup Flags. -} {---------------------------------------------------------------------------} Usr_UseLore = $08; { Use the Line Oriented Editor } Usr_More = $10; { Want's the More Prompt } Usr_Ansi = $20; { OPUS: User wants ANSI } Usr_Kludge = $40; { OPUS: Opus Used before } Usr_FormFeed = $80; { OPUS: Transmit } MaxUserRec = 4000; { The maximum number of Records available in memory } {---------------------------------------------------------------------------} {- Userfile Structure -} {---------------------------------------------------------------------------} TYPE _Usr = RECORD {*********************************} Name, {* First and Last-name. *} City:String[35]; {* City,Country. *} Lastread:Array[1..10] of _MsgArea;{* Lastread msg# for 10 areas. *} Password:String[15]; {* Password. *} Calls, {* Number of calls to system. *} HelpLevel, {* Helplevel (Nov,Reg,Exp). *} Tabs, {* Number of spaces pr. tab. *} Nulls, {* Number of nulls (delays). *} LastMsgArea, {* Message area last visited. *} Flags, {* Misc. flags for ANSI etc. *} Privilege:integer; {* Privilege level (T,D,N,P..H) *} LastDate:String[19]; {* Last time on system (ASCII). *} TimeToday, {* Number of minutes used today. *} BaudRate, {* Baudrate (Used with ^OC). *} Upload, {* Total upload in Kbytes. *} Download, {* Total download in Kbytes. *} Download_Now, {* Download this session in Kb. *} LastFileArea:integer; {* File area last visited. *} ScreenWidth, {* Width of users monitor. *} ScreenLength:byte; {* Hight of users monitor. *} Credit, {* Mail-credit in cents. *} Debit:integer; {* Mail-debit in cents. *} End; {*********************************} _UsrPtr = RECORD { For Use With UserFast routines } _Ptr : ARRAY[1..MaxUserRec] OF ^__Usr; _Recs : Integer; END; {***************************************************************************} {* OPUS MESSAGE HEADER Structure *} {***************************************************************************} CONST MaxTextLines = 300; {* Absolute max number of msg lines *} MsgPrivate = $0001; { Private Messages * 0000 0000 0000 0001 } MsgCrash = $0002; { Squirt Mail * 0000 0000 0000 0010 } Msgread = $0004; { Read by addressee * 0000 0000 0000 0100 } MsgSent = $0008; { Sent OK (remote) 0000 0000 0000 1000 } MsgFile = $0010; { File Attached to message * 0000 0000 0001 0000 } MsgFwd = $0020; { In Transit 0000 0000 0010 0000 } MsgOrphan = $0040; { Unknown Destination Node * 0000 0000 0100 0000 } MsgKill = $0080; { kill after bundling 0000 0000 1000 0000 } MsgLocal = $0100; { FidoNet vs Local 0000 0001 0000 0000 } MsgHold = $0200; { Hold Don't send * 0000 0010 0000 0000 } MsgXX2 = $0400; { reserved X? 0000 0100 0000 0000 } MsgFrq = $0800; { File request * 0000 1000 0000 0000 } MsgRrq = $1000; { Receipt requested X* 0001 0000 0000 0000 } MsgCpt = $2000; { is a return receipt X* 0010 0000 0000 0000 } MsgArq = $4000; { Audit trail requested X* 0100 0000 0000 0000 } MsgUrq = $8000; { Update Request X* 1000 0000 0000 0000 } {------------------------} { ^ } { | } { * = Preserved by } { the Network } { ? = Stripped by the } { net (FTSC spec) } { but preserved by } { Seadog } { X = Not used by OPUS } {------------------------} TYPE _MsgHead = Record _From:String[35]; _To:String[35]; _Subj:String[71]; _Date:String[19]; _Times:Integer; _Dest:Integer; _Orig:Integer; _Cost:Integer; _OrigNet:Integer; _DestNet:Integer; _Written:LongInt; _Arived:LongInt; _Reply:Integer; _Attr:Word; _Up:Integer; End; _Msg = Record _From:String[35]; _To:String[35]; _Subj:String[71]; _Date:String[19]; _Times:Integer; _Dest:Integer; _Orig:Integer; _Cost:Integer; _OrigNet:Integer; _DestNet:Integer; _Written:LongInt; _Arived:LongInt; _Reply:Integer; _Attr:Word; _Up:Integer; Lines:ARRAY[1..MaxTextLines] OF _Lines; NumberOfLines: Integer; End; {***************************************************************************} {* NODELIST *} {***************************************************************************} {* *} {* NodeList.Sys *} {* *} {* NET > 0 and NODE > 0 Normal node *} {* *} {* NET > 0 and NODE <= 0 Host node *} {* Net host........node== 0 *} {* Regional host...node==-1 *} {* Country host....node==-2 *} {* *} {* NET == -1 Nodelist.Sys revision *} {* *} {* NET == -2 Nodelist statement *} {* *} {***************************************************************************} {---------------------------------------------------------------------------} {- NODE Old style (Nodelist Version 5) -} {---------------------------------------------------------------------------} _Node = RECORD Number: Integer; { Node number } Net: Integer; { Net Number } Cost: Integer; { cost of a message to this node } Rate: Integer; { Baud rate } Name: STRING[19]; { Node Name } Phone: STRING[39]; { Phone Number } City: STRING[39]; { City and State } Password: STRING[7]; { Password String } END; CONST {---------------------------------------------------------------------------} {- Values for the `NodeFlags' field (Version 6 Nodelist, Binkley version) -} {---------------------------------------------------------------------------} B_hub = $0001; { node is a net hub 0000 0000 0000 0001 } B_host = $0002; { node is a net host 0000 0000 0000 0010 } B_region = $0004; { node is region coord 0000 0000 0000 0100 } B_zone = $0008; { node is a zone coord 0000 0000 0000 1000 } B_CM = $0010; { runs continuous mail 0000 0000 0001 0000 } B_ores1 = $0020; { reserved for Opus 0000 0000 0010 0000 } B_ores2 = $0040; { reserved for Opus 0000 0000 0100 0000 } B_ores3 = $0080; { reserved for Opus 0000 0000 1000 0000 } B_ores4 = $0100; { reserved for Opus 0000 0001 0000 0000 } B_ores5 = $0200; { reserved for Opus 0000 0010 0000 0000 } B_res1 = $0400; { reserved for non-Opus 0000 0100 0000 0000 } B_res2 = $0800; { reserved for non-Opus 0000 1000 0000 0000 } B_res3 = $1000; { reserved for non-Opus 0001 0000 0000 0000 } B_res4 = $2000; { reserved for non-Opus 0010 0000 0000 0000 } B_res5 = $4000; { reserved for non-Opus 0100 0000 0000 0000 } B_res6 = $8000; { reserved for non-Opus 1000 0000 0000 0000 } {---------------------------------------------------------------------------} {- NODE New style (Nodelist Version 6) (Stolen from Binkley) -} {---------------------------------------------------------------------------} TYPE _NewNode = RECORD Number: Word; { Node number } Net: Word; { Net Number } Cost: Word; { cost of a message to this node } Rate: Integer; { Baud rate } Name: STRING[33]; { Node Name } Phone: STRING[39]; { Phone Number } City: STRING[29]; { City and State } Password: STRING[8]; { Password String } RealCost: Word; { Phone company's charge } HubNode: Word; { node # of this node's hub or 0 if none } ModemType: Byte; { RESERVED for Modem Type } NodeFlags: Word; { Set of flags (See above) } END; {---------------------------------------------------------------------------} {- Nodelist.Idx File is terminated by EOF -} {---------------------------------------------------------------------------} _ndi = Record Node: INTEGER; { Node Number } Net: INTEGER; { Net Number } END; {***************************************************************************} {* OPUS CONTROL FILE AND PARM FILE DECLARATIONS *} {*************************************************************************-*} CONST CTL_VERSION=14; { OPUS Control file version } MAX_EXTERN=8; { Max external programs } MAXCLASS=12; { Number of possible priv levels } {---------------------------------------------------------------------------} {- Multitaskers (possible values for 'ctl.multitasker' 0 = no multask -} {---------------------------------------------------------------------------} DoubleDos = 1; DesqView = 2; TopView = 3; TaskView = 4; MsWindows = 5; {---------------------------------------------------------------------------} {- Matrix Mask Undefined bits are reserved for OPUS -} {---------------------------------------------------------------------------} No_Traffic = $0001; { OK to send outbound lokal 0000 0000 0000 0001 } Local_Only = $0002; { ok to send Outbound local 0000 0000 0000 0010 } Opus_Only = $0002; { only send to #CM systems 0000 0000 0000 0100 } No_Exits = $2000; { Crash/Arc exits ignored 0010 0000 0000 0000 } Mail_Only = $4000; { no human callers allowed 0100 0000 0000 0000 } Take_Req = $8000; { File requests are OK 1000 0000 0000 0000 } {---------------------------------------------------------------------------} {- Flags -} {---------------------------------------------------------------------------} Logecho = $0001; { Log echoMail areas. 0000 0000 0000 0001 } Steady = $0002; { never change baudrate 0000 0000 0000 0010 } TYPE {---------------------------------------------------------------------------} {- Information about a class of users. (Unstable Structure) -} {---------------------------------------------------------------------------} Class_Rec = RECORD Priv: INTEGER; Max_Time: INTEGER; { Max cume time per day } Max_Call: INTEGER; { Max time for one call } Max_DL: INTEGER; { Max download bytes per day } Ratio: WORD; { ul:dl ratio } Min_Baud: WORD; { Speed needed for logon } Min_File_Baud: WORD; { Speed needed for xfer } END; {---------------------------------------------------------------------------} {- The structure of a PRM file (Unstable Structure) -} {- -} {- Please notice the Version Number at offset zero. -} {---------------------------------------------------------------------------} _Prm = RECORD Version: BYTE; { For Safety } TestMode: BYTE; { Input From KeyBoard, Not Modem } {-} TotalCallers: LongInt; { Total Number of callers to system } {-} QuotePosition: LongInt; { Last position in Quote file } Multitasker: BYTE; { Multitasker Type See up Front } Snooping: BYTE; { Local Monitor Active } EditExit: BYTE; { 1= Use newuser questionaire } Verbose: BYTE; { Wordy SysOp Log } Terse: BYTE; { Brief SysOp Log } Trace: BYTE; { Log trace mode } ShowAreaPath: BYTE; { use path not DIR.BBS } TaskNum: BYTE; { Task number for multitask Systems } ExitVal: BYTE; { ERRORLEVEL to use after caller } ValOutside: BYTE; { ERRORLEVEL for O)utside } ValZero: BYTE; { ERRORLEVEL for SysOp O) command } NoCrashmail: BYTE; { 1= Don't accept Crashmail } AutoKill: BYTE; { RECD PVT msgs. 0=no, 1=ask, 2=yes } CrashExit: BYTE; { non zere = Errorlevel exit } UnpackArc: BYTE; { 1= Unpack incomming arcmail } TossEcho: BYTE; { 1=Toss incomming echomail } ArcExit: BYTE; { ERRORLEVEL for after rec. arcmail } UseDTR: BYTE; { 1 = DROP dtr look busy,0 off hook } CarrierMask: INTEGER; { } HandshakeMask: INTEGER; { } CtlaPriv: INTEGER; { Privil to se ^A lines in msgs } MaxBaud: INTEGER; { Fastest speed we can use } MinBaud: INTEGER; { Min baud rate to get online } SpeedGraphics: INTEGER; { Min Baud for graphics } ComPort:INTEGER; { 0=COM1, 1=COM2 ... } LogonPriv:INTEGER; { Accesslevel for new users } DateStyle: INTEGER; { Used for files.BBS display } SeenPriv: INTEGER; { Minimum priv to see SEEN-BY line } MsgAsk: ARRAY[1..16] OF INTEGER; { Array of Privs. for } { Massage attr ask's } MsgAssume: ARRAY[1..16] OF INTEGER; { Array of Privs. for } { Massage attr assumes } MsgFromfile:INTEGER; { Priv for doing msg from file } WatchDog: BYTE; { 1=set Fossil to reboot during Out } Video: BYTE; { 0=DOS, 1=FOSSIL, 2=IBM } {-} Filler: ARRAY[1..11] OF BYTE; {-} BFill: BYTE; Flags: BYTE; { Flags def up front } OurZone: WORD; { The current Zone } MatrixMask: WORD; { Look Up Front } ClassRec: ARRAY[1..MAXCLASS] OF Class_Rec; { Class Records } Alias: ARRAY[1..15] OF _ndi; { Node Numbers / Aliasses } MInit: _Str; { Modem init string } PreDial: _Str; { dial prefix sent before number } PostDial: _Str; { Sent after number } TimeFormat: _Str; { Look in BBS.CTL file } DateFormat: _Str; { Look in BBS.CTL file } FkeyPath: _Str; { Path to f-key files } ParmOutside: _Str; { Prog/Parms for outside file } ParmZero: _Str; { Parm for sysop O) command } SysPath: _Str; { Path to system??.BBS files } UserFile: _Str; { Path/filename to User.BBS file } NetInfo: _Str; { Path to nodelist } SchedName: _Str; { Name of SCHED FILE } Logo: _Str; { First file shown to caller } Welcome: _Str; { Shown after logon } Bulletin: _Str; { Shown after Welcome file } Edtorial: _Str; { Edtorial Menu file } Quote: _Str; { File containing Quotes } Question: _Str; { Questionaire available main menu } RequestList: _Str; { List of files approved for f.req } Newuser1: _Str; { Shown before new user enters PW } Newuser2: _Str; { Shown after new user enters Passw} Rookie: _Str; { Shown too rookies after Pasword } Application: _Str; { New user questionaire } AvailList: _Str; { File List FILES (f.req) } HlpEditor: _Str; { Intro to msg editor } HlpReplace: _Str; { Explain MSG editor E)dit command } MsgInquire: _Str; { Explain MSG I)nquire command } HlpLocate: _Str; { Explain File L)ocate command } HlpContents: _Str; { Explain the files contents comm } OutLeaving: _Str; { Bon Voyage a l'outside } OutReturn: _Str; { Welcome back from outside } DayLimit: _Str; { Sorry, You've been to long.... } TimeWarn: _Str; { Warning about forced hangup } SysOp: _Str; { SysOp's name } TooSlow: _Str; { Explains min logon baud. } Xferbaud: _Str; { Explains min file transf baud } MsgAreaList: _Str; { Dump file instead of DIR.BBS } FileAreaList: _Str; { Dump file instead of Dir.BBS } MailListFile: _Str; { Default nodelist file } ByeBye: _Str; { Displayed at logoff } FileProt1: _Str; { Some external file protocols } FileProt2: _Str; FileProt3: _Str; FileProt4: _Str; FileProt5: _Str; FileProt6: _Str; FileProt7: _Str; FileProt8: _Str; LocalEditor: _Str; { SysOps Local Editor } FileMgt: _Str; { External File Section Management } HoldArea: _Str; { Path to Outbound area } Barricade: _Str; Badaccess: _Str; MsgMgt: _Str; { External Message section mgt } MailPath: _Str; { Path to inbound bundles (MATRIX) } FilePath: _Str; { Path for inbound matrix files } OpedHelp: _Str; { OpEd help file } TempPath: _Str; { Place to put temporary files } ModemBusy: _Str; { Modem Busy String } SystemName: _Str; { System name string } AboutFile: _Str; { System Info file (About File) } LogName: _Str; { Log File Name } END; {***************************************************************************} {* OPUS SCHEDule file Structure *} {***************************************************************************} CONST MaxScheds = 35; {* Maximum number of events *} ExtEvent = 'X'; {* External event (return to Dos) *} YellEvent = 'Y'; {* Yell event (when yell is on) *} ForceEvent = $0001; {* Force this event. *} CleanHold = $0001; {* This Z-Event is a house cleaning event *} TYPE _Sched = Record Year: Word; {* Usable but doesn't make much sense *} Month: Word; {* Month of the current event *} Day: Word; {* Day of the Month *} DayWk: Word; {* Day of the week 0=Sun, 6=Sat, 7=all. *} Hour: Word; {* 0..23 Starting hour *} Min: Word; {* 0..59 Starting minute *} Sec: Word; {* Unused *} Len: Word; {* Length of the event *} Enable: Integer; {* 1= enabled *} Trigger: Word; {* Unknown/Unused *} Result: Word; {* X errorlevel, Y duration of Bell *} Tag: Char; {* Event Type 'A' .. 'Z' *} Junk_1: Byte; {* Dummy *} Last_ran: Word; {* Day of month when event was executed last *} B: Word; {* Reserved for OPUS *} C: Word; {* Reserved for external utilities *} Behavior: Word; {* Behavior of Z events. See tabble earlier *} EventMask: Byte; {* Force this event *} GMT: Byte; {* Set = GMT, Clear = Local time *} END; {---------------------------------------------------------------------------} {- Z-Event Behavior... -} {- IF RESULT = 1, The 'behavior' field contains a "Matrix Mask". Those -} {- are described in the PRM definations. -} {- IF RESULT = 2, It is an internal hausecleaning event. -} {---------------------------------------------------------------------------} _Scheds = ARRAY[1..MaxScheds] OF _Sched; FUNCTION OpIntERROR: Integer; { ERROR Variable Check this Allways } {*************************************************************************} {* ERROR Returns *} {* *} {* 0 = Everything is Bright and Sunny, Just go on *} {* 2 = File not found, Check your filename *} {* 3 = Path not found, Check your pathname *} {* 4 = Too many open files, We need one extra file. *} {* 5 = Fileaccess denied, Check file status. *} {* 12 = Invalid file acces code. *} {* 100 = Disk read error. *} {* 101 = Disk write error. *} {* 190 = Fossil is not loaded. *} {* 191 = Unable to find carrier. *} {* 192 = Carrier on current port has changed. *} {* 193 = Timeout reading port. *} {* 194 = Timeout writing port. *} {* 200 = .PRM file is to big ( > 8 KB ) *} {* 201 = Wrong CTL file version, You need another OPUS_CTL *} {* 202 = To much data for the .PRM file ( > 8 KB ) *} {* 210 = .MSG file is to big ( > 8 KB ) *} {* 211 = To many lines in message *} {* 212 = To many charecters to write message *} {* 220 = Cannot find User record *} {* 221 = To Many Records In UserFile *} {* 222 = Not Room For Extra User Record in The Structure *} {* 230 = Cannot find Nodelist Record *} {* 231 = Cannot find Nodelist Index Record *} {* 250 = Illegal Date / Time specified. *} {*************************************************************************} FUNCTION IOResult: INTEGER; {***************************************************************************} {* Return First OpInt Or I/O Error that occured.. look at OpIntERROR and *} {* TPAS Manual for error description *} {***************************************************************************} FUNCTION UpperCase(S: String):String; {***************************************************************************} {* Converts Strings to uppercase... *} {***************************************************************************} FUNCTION LowerCase(S: String):String; {***************************************************************************} {* Converts strings to lovercase... *} {***************************************************************************} FUNCTION SmartCase(S: String):String; {***************************************************************************} {* Converts string to First letter in word to Uppercase, rest to lovercase *} {***************************************************************************} FUNCTION GetEnvStr(S:String):String; {***************************************************************************} {* Return the EnvironMent String for the the Variabel S *} {* S Must be in Uppercase. *} {***************************************************************************} FUNCTION GMT_Difference:Integer; {***************************************************************************} {* Return an integer value of the difference from GMT (Uses TZ env var.) *} {***************************************************************************} PROCEDURE GetDateTime(VAR DT:DateTime); {***************************************************************************} {* Return a DateTime structure containing the current Date and Time. *} {***************************************************************************} FUNCTION DaysThisYear(DT: DateTime):Integer; {***************************************************************************} {* Give day number for the date specified in DT. (Note Year >= 1980) *} {***************************************************************************} FUNCTION PackUnixDate(DT:DateTime):LongInt; {***************************************************************************} {* Return number of Seconds since 1/1-1970 *} {***************************************************************************} PROCEDURE UnpackUnixDate(Date:LongInt; Var DT:DateTime); {***************************************************************************} {* Convert number of Seconds since 1/1-1970 to DateTime type. *} {***************************************************************************} FUNCTION PackDateString(DT:DateTime): String; {***************************************************************************} {* Return a string containing Time and Date from DT *} {* The format of the Date/Time string will be: *} {* 'dd-mon-yy hh:mm:ss' *} {* Ex. '24-May-88 12:22:21' *} {***************************************************************************} PROCEDURE UnpackDateString(S:String;Var DT:DateTime); {***************************************************************************} {* This Procedure will return the contents of a Date/time string in DT. *} {* The format of the Date/Time string Must be: *} {* 'dd-mon-yy hh:mm:ss' *} {* Ex. '24-May-88 12:22:21' *} {***************************************************************************} FUNCTION PackDateStrLog(DT:DateTime): String; {***************************************************************************} {* Return a string containing Time and Date from DT In LOG file Format *} {***************************************************************************} PROCEDURE AddLog(name:STRING; Flag: _StrSys; Subject: STRING); {***************************************************************************} { Add String in S to LogFile. With Date And Time Flag will contain prefix *} {***************************************************************************} PROCEDURE SetAttrib(Var Attribute; Flag: Word; Status:Boolean); {***************************************************************************} {* This procedure will change an attribute flag. *} {* WARNING: 'Attribute' MUST be of type 'Word' or of Type 'Integer'... *} {***************************************************************************} PROCEDURE ReadPrm(name:String; VAR Prm:_Prm); {***************************************************************************} {* ReadPrm reads the PRM file 'name' to the Variable 'Prm' *} {***************************************************************************} PROCEDURE WritePrm(name:String; VAR Prm:_Prm); {***************************************************************************} {* WritePrm writes the PRM file 'name' with the contents of 'Prm' *} {***************************************************************************} PROCEDURE ReadScheds(name:String; VAR Scheds:_Scheds); {***************************************************************************} {* ReadScheds reads the SCHEDULE file 'name' to the Vaiable 'Scheds' *} {***************************************************************************} PROCEDURE WriteScheds(name:String; VAR Scheds:_Scheds); {***************************************************************************} {* WriteScheds Rewrites the SCHEDULE file 'name' with the Vaiable 'Scheds' *} {***************************************************************************} PROCEDURE ReadSys(name:String; VAR Sys:_Sys); {***************************************************************************} {* ReadSys reads the SYSTEM??.BBS file 'name' to the Vaiable 'Sys' *} {***************************************************************************} PROCEDURE WriteSys(name:String; VAR Sys:_Sys); {***************************************************************************} {* WriteSys Rewrites the SYSTEM*.BBS file 'name' with the contents of 'Sys'*} {***************************************************************************} PROCEDURE ReadUser(name:String; VAR Usr:_Usr;Rec: WORD); {***************************************************************************} {* This procedure will read a user record from the file 'name' to the *} {* structure Usr, it will return the user record number 'rec' *} {***************************************************************************} PROCEDURE WriteUser(name:String; VAR Usr:_Usr;Rec: WORD); {***************************************************************************} {* This procedure will write a user record to the file 'name'. *} {* the variable Usr will be written to the user record number 'rec'. *} {***************************************************************************} FUNCTION NumberOfUsers(Name:String):Word; {***************************************************************************} {* Will return the number of users in the DiskFile 'Name' *} {***************************************************************************} PROCEDURE InitUserPtr(VAR UsrPtr:_UsrPtr); {***************************************************************************} {* Initialise the UsrPointer.. Must be called if you create a new userfile *} {* Using the followin User Management Procedures and functions. *} {***************************************************************************} PROCEDURE ReadUserFast(VAR UsrPtr:_UsrPtr; VAR Usr:_Usr; Recs: INTEGER); {***************************************************************************} {* This procedure will read a user records from the menory pool of _UsrPtr *} {***************************************************************************} PROCEDURE WriteUserFast(VAR UsrPtr:_UsrPtr;VAR Usr:_Usr; Recs: INTEGER); {***************************************************************************} {* This procedure will write one of the user records into menory *} {***************************************************************************} PROCEDURE ReleaseUserPtr(VAR UsrPtr:_UsrPtr); {***************************************************************************} {* Release the Heap space used by the UsrPointer variable. *} {***************************************************************************} PROCEDURE DelUserPtr(VAR UsrPtr:_UsrPtr; Rec:Integer); {***************************************************************************} {* Delete Single UserRecord From Memory and Release The Space Too *} {***************************************************************************} PROCEDURE InsUserPtr(VAR UsrPtr:_UsrPtr; VAR Usr:_Usr; Rec:Integer); {***************************************************************************} {* Insert New UserRecord In Heap as Number Rec. *} {***************************************************************************} PROCEDURE ReadUserFile(name:String; VAR UsrPtr:_UsrPtr; VAR Recs: INTEGER); {***************************************************************************} {* This procedure will read all the user records from the file 'name' into *} {* memory *} {***************************************************************************} PROCEDURE WriteUserFile(name:String; VAR UsrPtr:_UsrPtr); {***************************************************************************} {* This procedure will write all users in the memory pool wich is used by *} {* UsrPtr. It will be written to the file 'Name'. *} {***************************************************************************} PROCEDURE ReadNode(name:String; VAR Node:_Node;Rec: LongInt); {***************************************************************************} {* This procedure will read a Node record from the file 'name' to the *} {* structure Node, it will return the user record number 'rec' *} {***************************************************************************} PROCEDURE WriteNode(name:String; VAR Node:_Node;Rec: LongInt); {***************************************************************************} {* This procedure will write a Node record to a version 5 nodelist file *} {***************************************************************************} PROCEDURE ReadNewNode(name:String; VAR NewNode:_NewNode;Rec: LongInt); {***************************************************************************} {* This procedure will read a Node record from the file 'name' to the *} {* structure Node, it will return the user record number 'rec' *} {* For Use with nodelist version 6. *} {***************************************************************************} PROCEDURE WriteNewNode(name:String; VAR NewNode:_NewNode;Rec: LongInt); {***************************************************************************} {* This procedure will write a Node record to a version 6 nodelist file *} {***************************************************************************} FUNCTION NumberOfNodes(Name:String):LongInt; {***************************************************************************} {* Will return the number of users in the Nodelist.IDX file 'Name' *} {***************************************************************************} FUNCTION FindNode(name:String;Net,Node: Integer):LongInt; {***************************************************************************} {* FIND Nodelist Entry number *} {* name : Name of Nodelist Index file *} {* _net,_node : Net and Nodenumber *} {***************************************************************************} PROCEDURE ReadNdi(name:String; VAR Ndi:_Ndi;Rec: LongInt); {***************************************************************************} {* This procedure will read a Ndi record from the file 'name' to the *} {* structure Ndi, it will return the user record number 'rec' *} {***************************************************************************} PROCEDURE WriteNdi(name:String; VAR Ndi:_Ndi;Rec: LongInt); {***************************************************************************} {* This procedure will write a Node record to a nodeliste index file. The *} {* record number written is 'rec' *} {***************************************************************************} FUNCTION MsgLength(VAR Msg:_Msg):LongInt; {***************************************************************************} {* This function will return the number of charecters in the Message Msg *} {***************************************************************************} PROCEDURE ReadMsg(name:String; VAR Msg:_Msg); {***************************************************************************} {* This procedure will read a message with file name 'name' and return *} {* the header and Text in the structure Msg *} {***************************************************************************} PROCEDURE WriteMsg(name:String; VAR Msg:_Msg); {***************************************************************************} {* This procedure will write a message to a file name 'name' from the *} {* variable Msg. *} {***************************************************************************} PROCEDURE ReadMsgHead(name:String; VAR Msg:_Msg); {***************************************************************************} {* This procedure will read a message with file name 'name' and return *} {* the header in the structure Msg, The Msg body will not be read *} {***************************************************************************} PROCEDURE WriteMsgHead(name:String; VAR Msg:_Msg); {***************************************************************************} {* This procedure will write a message in the file named 'name'. *} {* The Msg body will not be changed. *} {***************************************************************************} PROCEDURE ReadMsgHeadNew(name:String; VAR MsgHead:_MsgHead); {***************************************************************************} {* This procedure will read a message with file name 'name' and return *} {* the header in the structure MsgHead, The Msg body will not be read. *} {***************************************************************************} PROCEDURE WriteMsgHeadNew(name:String; VAR MsgHead:_MsgHead); {***************************************************************************} {* This procedure will write a message in the file named 'name'. *} {* The Msg body will not be changed. *} {***************************************************************************} FUNCTION FirstFreeMsg(Path:String):String; {***************************************************************************} {* This function will return the first free message number in the area *} {* described by path. *} {***************************************************************************} PROCEDURE SetMsgAttr(Var Attribute: Word; Flag: Word; Status:Boolean); {***************************************************************************} {* This procedure will change the message attribute for a message *} {***************************************************************************} {#############################################################################} {# #} {# Here are some functions wich normaly are placed in the CRT unit #} {# #} {#############################################################################} PROCEDURE Delay(MS: Word); {***************************************************************************} {* Delay for MS milliseconds *} {***************************************************************************} FUNCTION KeyPressed: Boolean; {***************************************************************************} {* Return true if a key has been pressed *} {***************************************************************************} FUNCTION ReadKey: Char; {***************************************************************************} {* Read a Character from standard input *} {***************************************************************************} {#############################################################################} {# #} {# F O S S I L C O M U N I C A T I O N = O P - C O M #} {# #} {#############################################################################} CONST _MaxPort = 3; {* The highest port number (0..x) *} _On = True; _Off = False; VAR _Snoop: Boolean; {* Snoop Mode On or Off (Default is Off) *} _KeyBoard: Boolean; {* KeyBoard Mode On or Off (Default is Off) *} _ExitCarrier: Byte; {* Exit program on changed Carrier (Default is off) *} _EightBit: Boolean; {* Use 7 bit (Off) or 8 bits (On) (Default is On) *} _ForceCom: Boolean; {* Force write to Com port even if no carrier (off) *} PROCEDURE SetBaud(BaudRate:Word); {***************************************************************************} {* Sets the baudrate using FOSSIL function $0 *} {***************************************************************************} PROCEDURE ComSend(C:char); {***************************************************************************} {* Sends a single character to COM using FOSSIL function $1 *} {***************************************************************************} FUNCTION ComIn:char; {***************************************************************************} {* Reads a single character from COM using FOSSIL function $2 *} {***************************************************************************} FUNCTION InitPort(_Port:integer):boolean; {***************************************************************************} {* Initializes the specified COMport using function $4 *} {* This function will be true if there is a FOSSIL loaded *} {***************************************************************************} PROCEDURE DeInitPort(_Port:integer); {***************************************************************************} {* Deinitializes the specified COMport using function $5 *} {***************************************************************************} FUNCTION BufferEmpty:boolean; {***************************************************************************} {* True if the outputbuffer is empty *} {***************************************************************************} FUNCTION BufferReady:boolean; {***************************************************************************} {* False if the outputbuffer is full *} {***************************************************************************} FUNCTION ComGot:boolean; {***************************************************************************} {* True if a character is available in the inputbuffer. *} {***************************************************************************} FUNCTION Carrier:boolean; {***************************************************************************} {* True if carrier is present. *} {***************************************************************************} PROCEDURE SetDtr(_B:boolean); {***************************************************************************} {* Sets the DataTerminalReady Pin according to the boolean. *} {***************************************************************************} PROCEDURE FlushOut; {***************************************************************************} {* Waits for the outputbuffer to be emptied ( Use with care ). *} {***************************************************************************} PROCEDURE PurgeOut; {***************************************************************************} {* Empties the outputbuffer. *} {***************************************************************************} PROCEDURE PurgeIn; {***************************************************************************} {* Empties the inputbuffer. *} {***************************************************************************} FUNCTION KbdIn:char; {***************************************************************************} {* Reads a character from keyboard (wait if none available). *} {***************************************************************************} PROCEDURE ScreenWrite(C:char); {***************************************************************************} {* Writes a character to screen throug the ANSI driver. *} {***************************************************************************} PROCEDURE SetWatchdg(_B:boolean); {***************************************************************************} {* Enables/disables the 'boot machine if carrier lost' watchdog *} {***************************************************************************} PROCEDURE SendChar(C:char); {***************************************************************************} {* This routine will send the character to the selected port and if snoop *} {* or keyboard mode to the screen. *} {***************************************************************************} FUNCTION ReadCom:char; {***************************************************************************} {* This routine gets a single character from the keyboard or seriel port *} {***************************************************************************} PROCEDURE GetPort(VAR ComPort:Integer); {***************************************************************************} {* This Procedure will return the number of the current active port. *} {***************************************************************************} PROCEDURE SetPort(ComPort:Integer); {***************************************************************************} {* This procedure will set a port to be active. *} {***************************************************************************} PROCEDURE InitFossil(ComPort,BaudRate:Integer); {***************************************************************************} {* This function will initialize a Com port for FOSSIL operation. *} {***************************************************************************} PROCEDURE FindPort; {***************************************************************************} {* Searches COM1..COM4 for carrier and if carrier is found that port will *} {* port will be initialized and used. If no carrier found COM1 will be *} {* selected, and OpIntERROR variable will be set to 190. *} {***************************************************************************} PROCEDURE UseFossil; {***************************************************************************} {* This function will initialize a Com port for FOSSIL operation. *} {* It will find the first Com Port with Carrier and use this. *} {***************************************************************************} PROCEDURE SafeFlush; {***************************************************************************} {* Wait for a max.5 minuttes for the outputbuffer to get empty. *} {***************************************************************************} {#############################################################################} {# #} {# T e x t F i l e D e v i c e D r i v e r . #} {# #} {#############################################################################} PROCEDURE PurgeInFossil(VAR F:Text); {***************************************************************************} {* Purge the contents of the inputbuffer for the current port *} {***************************************************************************} PROCEDURE PurgeOutFossil(VAR F:Text); {***************************************************************************} {* Purge the contents of the outputbuffer for the current port *} {***************************************************************************} FUNCTION FossilCarrier(VAR F:Text):Boolean; {***************************************************************************} {* True if there is carrier on the current port. *} {***************************************************************************} FUNCTION FossilPressed(VAR F:Text):Boolean; {***************************************************************************} {* True if there is a character ready in the input buffer for this port. *} {***************************************************************************} FUNCTION ReadFossil(VAR F:Text):Char; {***************************************************************************} {* Read single charecter from an Fossil Text file driver *} {***************************************************************************} PROCEDURE AssignFossil(VAR F: text; Port,Baud: Word); {***************************************************************************} {* Assign A Text File Device Driver *} {***************************************************************************} PROCEDURE SetSnoopFossil(VAR F: text; _Snoop: Boolean); {***************************************************************************} {* Enable/Disable Snoop mode for this device. *} {***************************************************************************} PROCEDURE SetKeyboardFossil(VAR F: text; _Keyboard: Boolean); {***************************************************************************} {* Enable/Disable Keyboardmode for this Device. *} {***************************************************************************} PROCEDURE SetExitFossil(VAR F: text; _Exit: Byte); {***************************************************************************} {* Set errorlevel to exit with if change inncarrier (if '0' don't exit) *} {***************************************************************************} PROCEDURE UseInOut(Port,Baud:Word); {**************************************************************************} {* Redirect standart input and output to Comport and maybe screen *} {**************************************************************************} PROCEDURE UnUseInOut; {**************************************************************************} {* Normalise input and output text files to the original. *} {**************************************************************************}